home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_FileRunner.idb / usr / freeware / lib / FileRunner2.5 / cmd.tcl.z / cmd.tcl
Encoding:
Text File  |  1999-01-26  |  40.5 KB  |  1,317 lines

  1.  
  2.  
  3. proc CmdToright {} {
  4.   global glob
  5.   NewPwd right $glob(left,pwd)
  6.   UpdateWindow right
  7. }
  8.  
  9. proc CmdToleft {} {
  10.   global glob
  11.   NewPwd left $glob(right,pwd)
  12.   UpdateWindow left
  13. }
  14.  
  15. proc CmdSwapWindows {} {
  16.   global glob
  17.   set tmpleft $glob(right,pwd)
  18.   set tmpright $glob(left,pwd)
  19.   NewPwd left $tmpleft
  20.   NewPwd right $tmpright
  21.   UpdateWindow both 
  22. }
  23.  
  24. proc BatchReceiveFTP { inst } {
  25.   global glob
  26.   if {[IsFTP $glob($inst,pwd)]} {
  27.     PopInfo "You can only issue a receive request to a non-FTP directory"
  28.     return
  29.   }
  30.   set olddir $glob([Opposite $inst],pwd)
  31.   foreach itemblock $glob(batchlist) {
  32.     set item [lindex $itemblock 0]
  33.     set r [regexp {ftp://([^/]*)(.*)} $item match ftpI elem]
  34.     if {!$r} {
  35.       PopWarn "Can't parse $item as FTP file"
  36.     } else {
  37.       NewPwd [Opposite $inst] ftp://$ftpI/
  38.       set r [Try { FTP_GetFile $ftpI "$elem" "$glob($inst,pwd)/[file tail $elem]" [lindex $itemblock 1] 0 } "" 1]
  39.     }
  40.   }
  41.   set glob(batchlist) {}
  42.   set glob(forceupdate) 1
  43.   NewPwd [Opposite $inst] $olddir
  44.   UpdateWindow both
  45.   set glob(forceupdate) 0
  46. }
  47.  
  48.  
  49. proc CmdCopy {{resume 0}} {
  50.   global glob
  51.   if { $glob(left,pwd) == $glob(right,pwd) } {
  52.     tk_dialog .apop "Hey Dimwit!" \
  53.        "Please set different source and destination directories!" "" 0 "OK" 
  54.     return {}
  55.   }    
  56.   CmdCopy_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd) left $resume
  57.   CmdCopy_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd) right $resume
  58.   UpdateWindow both
  59.   set glob(forceupdate) 0
  60. }
  61.  
  62. proc CmdCopy_ { listb_name filelist_var frompwd topwd inst resume} {
  63.   # For speed, (hopefully) we'll call by reference...
  64.   global config glob
  65.   upvar $filelist_var filelist
  66.  
  67.  
  68.   foreach sel [$listb_name curselection] {
  69.     if {[CheckAbort "Copy"]} return
  70.     set elem [lindex $filelist $sel]
  71.     switch [lindex $elem 2] {
  72.       fld -
  73.       fd  { 
  74.         if {[IsFTP $topwd]} {
  75.           CantDoThat
  76.           return
  77.         }
  78.         set olddir $glob($inst,pwd)
  79.         set r [Try { CopyFromFTPRecursive "$frompwd/[lindex $elem 1]" "$topwd" $inst $resume } "" 1]
  80.         NewPwd $inst $olddir
  81.         UpdateWindow $inst
  82.       }
  83.       fl  -
  84.       fn  {
  85.         if {[IsFTP $topwd]} {
  86.           CantDoThat
  87.           return
  88.         }
  89.         set r [regexp {ftp://([^/]*)(.*)} $frompwd match ftpI directory]
  90.         if {$r == 0} { 
  91.           PopError "Can't parse $frompwd as ftp URL" 
  92.         } else {
  93.           set size [lindex $elem 3]
  94.           if {[lindex $elem 2] == "fl"} {set size -1}
  95.           if {$glob(async)} {
  96.             catch {exec $glob(lib_fr)/frftp $glob(lib_fr) $config(ftp,timeout) 1 $glob(ftp,$ftpI,host) \
  97.                        $glob(ftp,$ftpI,user) $glob(ftp,$ftpI,passwd) $ftpI "$directory/[lindex $elem 1]" \
  98.                        "$topwd/[lindex $elem 1]" $size $resume &} out
  99.           } else {
  100.             set r [Try { FTP_GetFile $ftpI "$directory/[lindex $elem 1]" "$topwd/[lindex $elem 1]" $size $resume } "" 1]
  101.           }
  102.         }
  103.       }
  104.       l   { 
  105.         Log "Copying $frompwd/[lindex $elem 1] to $topwd"
  106.         set r [regexp {ftp://([^/]*)(.*)} $topwd match ftpI directory]
  107.         if {$r} {
  108.           set glob(forceupdate) 1
  109.           Try { FTP_PutFile $ftpI $frompwd/[lindex $elem 1] $directory/[lindex $elem 1] [lindex $elem 3] } "" 1
  110.         } else {
  111.           if {[CheckWhoOwns $topwd/[lindex $elem 1] overwrite]} {
  112.             Try { exec $config(cmd,cp) $frompwd/[lindex $elem 1] $topwd } "" 1 
  113.           }
  114.         }
  115.       }
  116.       n   { 
  117.         Log "Copying $frompwd/[lindex $elem 1] to $topwd"
  118.         set r [regexp {ftp://([^/]*)(.*)} $topwd match ftpI directory]
  119.         if {$r} {
  120.           set glob(forceupdate) 1
  121.           Try { FTP_PutFile $ftpI $frompwd/[lindex $elem 1] $directory/[lindex $elem 1] [lindex $elem 3] } "" 1
  122.         } else {
  123.           if {[CheckWhoOwns $topwd/[lindex $elem 1] overwrite]} {
  124.             Try { file copy -force -- $frompwd/[lindex $elem 1] $topwd } "" 1 
  125.           }
  126.         }
  127.       }
  128.       d   { 
  129.         if {[IsFTP $topwd]} {
  130.           set olddir $glob($inst,pwd)
  131.           set r [Try { CopyToFTPRecursive "$frompwd/[lindex $elem 1]" "$topwd" $inst } "" 1]
  132.           NewPwd $inst $olddir
  133.           set glob(forceupdate) 1
  134.         } else {
  135.           Log "Copying $frompwd/[lindex $elem 1] to $topwd"
  136.           if {[CheckWhoOwns $topwd/[lindex $elem 1] overwrite]} {
  137.             Try { 
  138.               cd $frompwd
  139.               exec $config(cmd,sh) -c "tar cf - '[lindex $elem 1]' | (cd '$topwd'; tar xfp - )" } "" 1 $glob(async)
  140.           }
  141.         }
  142.       }
  143.       ld  { 
  144.         if {[IsFTP $topwd]} {
  145.           CantDoThat
  146.           return
  147.         }
  148.         Log "Copying $frompwd/[lindex $elem 1] to $topwd"
  149.         if {[CheckWhoOwns $topwd/[lindex $elem 1] overwrite]} {
  150.           Try { 
  151.             cd $frompwd/[lindex $elem 1]
  152.             file mkdir $topwd/[lindex $elem 1]
  153.             exec $config(cmd,sh) -c "tar cf - . | (cd '$topwd/[lindex $elem 1]'; tar xfp - )" } "" 1 $glob(async)
  154.         }
  155.       }
  156.       default CantDoThat
  157.     }
  158.   }
  159. }
  160.  
  161. proc CmdCopyAs {} {
  162.   global glob
  163.   CmdCopyAs_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  164.   CmdCopyAs_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  165.   UpdateWindow both
  166. }
  167.  
  168. proc CmdCopyAs_ { listb_name filelist_var frompwd topwd } {
  169.   # For speed, (hopefully) we'll call by reference...
  170.   global config glob
  171.   upvar $filelist_var filelist
  172.  
  173.   foreach sel [$listb_name curselection] {
  174.     if {[CheckAbort "CopyAs"]} return
  175.     set elem [lindex $filelist $sel]
  176.     switch [lindex $elem 2] {
  177.       fl  -
  178.       fn  {
  179.         set destfile [EntryDialog "Copy As..." "Please enter new name for destination file" $topwd/[lindex $elem 1] question]
  180.         if {$destfile != "" } {
  181.           if {[IsFTP $destfile]} {
  182.             CantDoThat
  183.             return
  184.           }
  185.           set r [regexp {ftp://([^/]*)(.*)} $frompwd match ftpI directory]
  186.           if {$r == 0} { 
  187.             PopError "Can't parse $frompwd as ftp URL" 
  188.           } else {
  189.             set size [lindex $elem 3]
  190.             if {[lindex $elem 2] == "fl"} {set size -1}
  191.             if {$glob(async)} {
  192.               catch {exec $glob(lib_fr)/frftp $glob(lib_fr) $config(ftp,timeout) 1 $glob(ftp,$ftpI,host) \
  193.                          $glob(ftp,$ftpI,user) $glob(ftp,$ftpI,passwd) $ftpI "$directory/[lindex $elem 1]" \
  194.                          "$destfile" $size 0 &} out
  195.             } else {
  196.               set r [Try { FTP_GetFile $ftpI "$directory/[lindex $elem 1]" "$destfile" $size 0 } "" 1]
  197.             }
  198.           }
  199.         }
  200.       }
  201.       l   { 
  202.         set destfile [EntryDialog "Copy As..." "Please enter new name for destination file" $topwd/[lindex $elem 1] question]
  203.         if {[IsFTP $destfile]} {
  204.           CantDoThat
  205.           return
  206.         }
  207.         if {$destfile != "" } {
  208.           Log "Copying $frompwd/[lindex $elem 1] to $destfile"
  209.           Try { exec $config(cmd,cp) $frompwd/[lindex $elem 1] $destfile } "" 1  $glob(async)
  210.         }
  211.       }
  212.       n   { 
  213.         set destfile [EntryDialog "Copy As..." "Please enter new name for destination file" $topwd/[lindex $elem 1] question]
  214.         if {[IsFTP $destfile]} {
  215.           CantDoThat
  216.           return
  217.         }
  218.         if {$destfile != "" } {
  219.           Log "Copying $frompwd/[lindex $elem 1] to $destfile"
  220.           Try { file copy -force -- $frompwd/[lindex $elem 1] $destfile } "" 1  $glob(async)
  221.         }
  222.       }
  223.       d   -
  224.       ld  { 
  225.         set destdir [EntryDialog "Copy As..." "Please enter new name for directory after copy" $topwd/[lindex $elem 1] question]
  226.         if {[IsFTP $destdir]} {
  227.           CantDoThat
  228.           return
  229.         }
  230.         if {$destdir != "" } {
  231.           Log "Copying $frompwd/[lindex $elem 1] to $destdir"
  232.           Try { 
  233.             cd $frompwd/[lindex $elem 1]
  234.             file mkdir $destdir
  235.             exec $config(cmd,sh) -c "tar cf - . | (cd '$destdir'; tar xfp - )" } "" 1 $glob(async)
  236.         }
  237.       }
  238.       default CantDoThat
  239.     }
  240.   }
  241. }
  242.  
  243. proc SoftLink { src dst } {
  244.   global config
  245.   if {$config(create_relative_links)} {
  246.     set srcdir [file dirname $src]
  247.     set dstdir [file dirname $dst]
  248.     set srcfile [file tail $src]
  249.     set dstfile [file tail $dst]
  250.     set dstlist [split $dstdir /]
  251.     set srclist [split $srcdir /]
  252.     set dstlen [llength $dstlist]
  253.     set srclen [llength $srclist]
  254.     # Count how many directories are the same in the source and destination paths
  255.     set index 0
  256.     while {([lindex $srclist $index] == [lindex $dstlist $index]) && ($index < $srclen) && ($index < $dstlen)} {
  257.       incr index
  258.     }
  259.     # Build relative link
  260.     set link {}
  261.     for {set dstindex $index} {$dstindex < $dstlen} {incr dstindex} {
  262.       append link ../
  263.     }
  264.     for {set srcindex $index} {$srcindex < $srclen} {incr srcindex} {
  265.       append link [lindex $srclist $srcindex]/
  266.     }
  267.     set from $link$srcfile
  268.  
  269.     #puts "$src $dst $srcdir $srcfile $dstdir $dstfile : ln -s $from $dst"
  270.     Try { exec $config(cmd,ln) -s "$from" "$dst" } "" 1 
  271.   } else {
  272.     Try { exec $config(cmd,ln) -s "$src" "$dst" } "" 1 
  273.   }
  274. }
  275.  
  276. proc CmdSoftLink {} {
  277.   global glob
  278.   if { $glob(left,pwd) == $glob(right,pwd) } {
  279.     tk_dialog .apop "Hey Dimwit!" \
  280.        "Please set different source and destination directories!" "" 0 "OK" 
  281.     return {}
  282.   }    
  283.   if {[IsFTP $glob(left,pwd)] || [IsFTP $glob(right,pwd)]} {
  284.     CantDoThat
  285.     return
  286.   }
  287.   CmdSoftLink_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  288.   CmdSoftLink_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  289.   UpdateWindow both
  290. }
  291.  
  292. proc CmdSoftLink_ { listb_name filelist_var frompwd topwd } {
  293.   # For speed, (hopefully) we'll call by reference...
  294.   global config
  295.   upvar $filelist_var filelist
  296.  
  297.   foreach sel [$listb_name curselection] {
  298.     if {[CheckAbort "SoftLink"]} return
  299.     set elem [lindex $filelist $sel]
  300.     switch [lindex $elem 2] {
  301.       n   -
  302.       d   -
  303.       l   -
  304.       ld  { 
  305.         Log "Softlinking $frompwd/[lindex $elem 1] to $topwd"
  306.         SoftLink $frompwd/[lindex $elem 1] $topwd/[lindex $elem 1]
  307.       }
  308.       default CantDoThat
  309.     }
  310.   }
  311. }
  312.  
  313. proc CmdSoftLinkAs {} {
  314.   global glob
  315.   if {[IsFTP $glob(left,pwd)] || [IsFTP $glob(right,pwd)]} {
  316.     CantDoThat
  317.     return
  318.   }
  319.   CmdSoftLinkAs_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  320.   CmdSoftLinkAs_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  321.   UpdateWindow both
  322. }
  323.  
  324. proc CmdSoftLinkAs_ { listb_name filelist_var frompwd topwd } {
  325.   # For speed, (hopefully) we'll call by reference...
  326.   global config
  327.   upvar $filelist_var filelist
  328.  
  329.   foreach sel [$listb_name curselection] {
  330.     if {[CheckAbort "SoftLinkAs"]} return
  331.     set elem [lindex $filelist $sel]
  332.     switch [lindex $elem 2] {
  333.       n   -
  334.       d   -
  335.       l   -
  336.       ld  {
  337.         set destfile [EntryDialog "Soft-Link As..." "Please enter new name for destination link" $topwd/[lindex $elem 1] question]
  338.         if {[IsFTP $destfile]} {
  339.           CantDoThat
  340.           return
  341.         }
  342.         if {$destfile != "" } {
  343.           Log "Softlinking $frompwd/[lindex $elem 1] to $destfile"
  344.           SoftLink $frompwd/[lindex $elem 1] $destfile
  345.         }
  346.       }
  347.       default CantDoThat
  348.     }
  349.   }
  350. }
  351.  
  352.  
  353. proc CmdMove {} {
  354.   global glob
  355.   if { $glob(left,pwd) == $glob(right,pwd) } {
  356.     tk_dialog .apop "Hey Dimwit!" \
  357.        "Please set different source and destination directories!" "" 0 "OK" 
  358.     return {}
  359.   }    
  360.   if {[IsFTP $glob(left,pwd)] || [IsFTP $glob(right,pwd)]} {
  361.     CantDoThat
  362.     return
  363.   }
  364.   CmdMove_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  365.   CmdMove_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  366.   UpdateWindow both
  367. }
  368.  
  369. proc CmdMove_ { listb_name filelist_var frompwd topwd } {
  370.   # For speed, (hopefully) we'll call by reference...
  371.   global config glob
  372.   upvar $filelist_var filelist
  373.  
  374.   foreach sel [$listb_name curselection] {
  375.     if {[CheckAbort "Move"]} return
  376.     set elem [lindex $filelist $sel]
  377.     switch [lindex $elem 2] {
  378.       d   -
  379.       l   -
  380.       ld  -
  381.       n   { 
  382.         if {[CheckWhoOwns $frompwd/[lindex $elem 1] move] && [CheckWhoOwns $topwd/[lindex $elem 1] overwrite]} {
  383.           Log "Moving $frompwd/[lindex $elem 1] to $topwd"
  384.           Try { file rename -force -- $frompwd/[lindex $elem 1] $topwd } "" 1 $glob(async)
  385.         }
  386.       }
  387.       default CantDoThat
  388.     }
  389.   }
  390. }
  391.  
  392. proc CmdDelete {} {
  393.   global glob
  394.   CmdDelete_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd) left
  395.   CmdDelete_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd) right
  396.   UpdateWindow both
  397.   set glob(forceupdate) 0
  398. }
  399.  
  400. proc CmdDelete_ { listb_name filelist_var frompwd topwd inst } {
  401.   # For speed, (hopefully) we'll call by reference...
  402.   global config glob
  403.   upvar $filelist_var filelist
  404.  
  405.   foreach sel [$listb_name curselection] {
  406.     if {[CheckAbort "Delete"]} return
  407.     set elem [lindex $filelist $sel]
  408.     switch [lindex $elem 2] {
  409.       l   -
  410.       ld  -
  411.       n   { 
  412.         set ask 0
  413.         if {$config(ask,file_delete)} {
  414.           set ask [tk_dialog_fr .apop "Sure?" "OK to delete file $frompwd/[lindex $elem 1] ?" "" 1 "Yes" "No"]
  415.         }
  416.         if {$ask == 0} {
  417.           if {[CheckWhoOwns $frompwd/[lindex $elem 1] delete]} {
  418.             Log "Deleting $frompwd/[lindex $elem 1]"
  419.             Try { file delete -force -- $frompwd/[lindex $elem 1] } "" 1
  420.           }
  421.         }
  422.       }
  423.       d   {
  424.         set ask 0
  425.         if {$config(ask,dir_delete)} {
  426.           set ask [tk_dialog_fr .apop "Sure?" "OK to delete directory tree $frompwd/[lindex $elem 1] ?" "" 1 "Yes" "No"]
  427.         }
  428.         if {$ask == 0} {
  429.           if {[CheckWhoOwns $frompwd/[lindex $elem 1] delete]} {
  430.             Log "Deleting $frompwd/[lindex $elem 1]"
  431.             Try { exec $config(cmd,rm) -rf $frompwd/[lindex $elem 1] } "" 1 $glob(async)
  432.           }
  433.         }
  434.       }
  435.       fn  -
  436.       fld -
  437.       fl  {
  438.         set ask 0
  439.         if {$config(ask,file_delete)} {
  440.           set ask [tk_dialog_fr .apop "Sure?" "OK to delete file $frompwd/[lindex $elem 1] ?" "" 1 "Yes" "No"]
  441.         }
  442.         if {$ask == 0} {
  443.           Log "Deleting $frompwd/[lindex $elem 1]"
  444.           set r [regexp {ftp://([^/]*)(.*)} $frompwd/[lindex $elem 1] match ftpI file]
  445.           if {$r} {
  446.             set glob(forceupdate) 1
  447.             Try { FTP_Delete $ftpI "$file" } "" 1
  448.           }
  449.         }
  450.       }
  451.       fd  {
  452.         set ask 0
  453.         if {$config(ask,dir_delete)} {
  454.           set ask [tk_dialog_fr .apop "Sure?" "OK to delete directory tree $frompwd/[lindex $elem 1] ?" "" 1 "Yes" "No"]
  455.         }
  456.         if {$ask == 0} {
  457.           Log "Deleting $frompwd/[lindex $elem 1]"
  458.           set glob(forceupdate) 1
  459.           Try { DeleteFTPRecursive "$frompwd/[lindex $elem 1]" $inst } "" 1
  460.         }
  461.       }
  462.       default CantDoThat
  463.     }
  464.   }
  465. }
  466.  
  467. proc CmdView {} {
  468.   global glob
  469.   CmdView_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd) left
  470.   CmdView_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd) right
  471. }
  472.  
  473. proc CmdView_ { listb_name filelist_var frompwd topwd inst } {
  474.   # For speed, (hopefully) we'll call by reference...
  475.   global glob config env
  476.   upvar $filelist_var filelist
  477.   set filenamelist {}
  478.   foreach sel [$listb_name curselection] {
  479.     if {[CheckAbort "View"]} return
  480.     set fileelem [lindex $filelist $sel]
  481.     switch [lindex $fileelem 2] {
  482.       l   -
  483.       n   { lappend filenamelist $frompwd/[lindex $fileelem 1] }
  484.       fd  -
  485.       fld -
  486.       ld  - 
  487.       d   { NewPwd $inst $glob($inst,pwd)/[lindex $fileelem 1]
  488.             UpdateWindow $inst
  489.             return
  490.           }
  491.       fn  -
  492.       fl  {
  493.             set r [regexp {ftp://([^/]*)(.*)} $glob($inst,pwd) match ftpI directory]
  494.             if {$r == 0} { 
  495.               PopError "Can't parse $glob($inst,pwd) as ftp URL" 
  496.             } else { 
  497.               set r 0
  498.               if { ! [file exists $glob(tmpdir)] } {
  499.                 set r [Try { file mkdir $glob(tmpdir) } "" 1]
  500.               }
  501.               if { !$r } {
  502.                 set size [lindex $fileelem 3]
  503.                 if {[lindex $fileelem 2] == "fl"} {set size -1}
  504.                 set r [Try { FTP_GetFile $ftpI "$directory/[lindex $fileelem 1]" "$glob(tmpdir)/[lindex $fileelem 1]" $size 0 } "" 1]
  505.                 if {$r == 0} { ViewAny $glob(tmpdir)/[lindex $fileelem 1]; set glob(havedoneftp) 1 }
  506.               }
  507.             }
  508.           }
  509.       default CantDoThat
  510.     }
  511.   }
  512.   if {$filenamelist != {}} {
  513.     ViewAny $filenamelist
  514.   }
  515. }
  516.  
  517. proc CmdViewAsText {} {
  518.   global glob
  519.   CmdViewAsText_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  520.   CmdViewAsText_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  521. }
  522.  
  523. proc CmdViewAsText_ { listb_name filelist_var frompwd topwd } {
  524.   # For speed, (hopefully) we'll call by reference...
  525.   upvar $filelist_var filelist
  526.   set filenamelist {}
  527.   foreach sel [$listb_name curselection] {
  528.     set elem [lindex $filelist $sel]
  529.     switch [lindex $elem 2] {
  530.       l   -
  531.       n   { ViewText $frompwd/[lindex $elem 1] }
  532.       ld  -
  533.       d   { PopInfo "Can't view directory $frompwd/[lindex $elem 1] in the text viewer" }
  534.       default CantDoThat
  535.     }
  536.   }
  537. }
  538.  
  539. proc CmdCheckSize {} {
  540.   global glob
  541.   CmdCheckSize_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd) left
  542.   CmdCheckSize_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd) right
  543. }
  544.  
  545. proc CmdCheckSize_ { listb_name filelist_var frompwd topwd inst } {
  546.   # For speed, (hopefully) we'll call by reference...
  547.   global glob config env
  548.   upvar $filelist_var filelist
  549.   set filenamelist {}
  550.   foreach sel [$listb_name curselection] {
  551.     if {[CheckAbort "View"]} return
  552.     set fileelem [lindex $filelist $sel]
  553.     switch [lindex $fileelem 2] {
  554.       d   -
  555.       ld  -
  556.       l   -
  557.       n   { lappend filenamelist [Esc $frompwd/[lindex $fileelem 1]] }
  558.       default CantDoThat
  559.     }
  560.   }
  561.   if {$filenamelist != {}} {
  562.     set r [catch {eval eval exec $config(cmd,du) $filenamelist} out]
  563.     if {$r} {
  564.       PopError $out
  565.     } else {
  566.       ViewString "Output from du" out ""
  567.     }
  568.   }
  569. }
  570.  
  571. proc CmdWhatIs {} {
  572.   global glob
  573.   CmdWhatIs_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  574.   CmdWhatIs_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  575. }
  576.  
  577. proc CmdWhatIs_ { listb_name filelist_var frompwd topwd } {
  578.   # For speed, (hopefully) we'll call by reference...
  579.   upvar $filelist_var filelist
  580.   set filenamelist {}
  581.   foreach sel [$listb_name curselection] {
  582.     set elem [lindex $filelist $sel]
  583.     switch [lindex $elem 2] {
  584.       l   -
  585.       n   -
  586.       ld  -
  587.       d   { Try { PopInfo [exec file "$frompwd/[lindex $elem 1]"] } "" 1 
  588.           }
  589.       default CantDoThat
  590.     }
  591.   }
  592. }
  593.  
  594. proc CmdEdit {} {
  595.   global glob
  596.   CmdEdit_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  597.   CmdEdit_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  598. }
  599.  
  600. proc CmdEdit_ { listb_name filelist_var frompwd topwd } {
  601.   global env config
  602.   # For speed, (hopefully) we'll call by reference...
  603.   upvar $filelist_var filelist
  604.   set filenamelist {}
  605.  
  606.   foreach sel [$listb_name curselection] {
  607.     set elem [lindex $filelist $sel]
  608.     switch [lindex $elem 2] {
  609.       l   -
  610.       n   { lappend filenamelist [Esc $frompwd/[lindex $elem 1]] }
  611.       ld  -
  612.       d   { PopInfo "Can't edit directory $frompwd/[lindex $elem 1] in the text editor" }
  613.       default CantDoThat
  614.     }
  615.   }
  616.   if {$filenamelist != {}} {
  617.     # Three eval's in a row... New record? Yuck..
  618.     Try { eval eval eval exec [format $config(editor) $filenamelist] & } "Can't start editor" 1
  619.   }
  620. }
  621.  
  622. proc CmdQEdit {} {
  623.   global glob
  624.   CmdQEdit_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  625.   CmdQEdit_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  626. }
  627.  
  628. proc CmdQEdit_ { listb_name filelist_var frompwd topwd } {
  629.   # For speed, (hopefully) we'll call by reference...
  630.   global glob
  631.   upvar $filelist_var filelist
  632.  
  633.   foreach sel [$listb_name curselection] {
  634.     if {[CheckAbort "Q-Edit"]} return
  635.     set elem [lindex $filelist $sel]
  636.     switch [lindex $elem 2] {
  637.       l   -
  638.       n   { 
  639.             set r [Try {EditText "$frompwd/[lindex $elem 1]" ""} "Error editing $frompwd/[lindex $elem 1]" 1]
  640.             if {$r != 0} { catch { destroy .toplevel_$glob(toplevelidx) } }
  641.           }
  642.       ld  -
  643.       d   { PopInfo "Can't edit directory $frompwd/[lindex $elem 1] in the text editor" }
  644.       default CantDoThat
  645.     }
  646.   }
  647. }
  648.  
  649.  
  650. proc CmdRename {} {
  651.   global glob
  652.   CmdRename_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  653.   CmdRename_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  654.   UpdateWindow both
  655.   set glob(forceupdate) 0
  656. }
  657.  
  658. proc CmdRename_ { listb_name filelist_var frompwd topwd } {
  659.   # For speed, (hopefully) we'll call by reference...
  660.   global config glob
  661.   upvar $filelist_var filelist
  662.  
  663.   foreach sel [$listb_name curselection] {
  664.     if {[CheckAbort "Rename"]} return
  665.     set elem [lindex $filelist $sel]
  666.     switch [lindex $elem 2] {
  667.       d   -
  668.       l   -
  669.       ld  -
  670.       n   { 
  671.         if {[CheckWhoOwns $frompwd/[lindex $elem 1] rename]} {
  672.           set newname [EntryDialog "Rename" "Please enter new name." $frompwd/[lindex $elem 1] question]
  673.           if {$newname != ""} {
  674.             if {[CheckWhoOwns $newname overwrite]} {
  675.               Log "Renaming $frompwd/[lindex $elem 1] to $newname"
  676.               Try { file rename -force -- $frompwd/[lindex $elem 1] $newname } "" 1
  677.             }
  678.           }
  679.         }
  680.       }
  681.       fl  -
  682.       fld -
  683.       fd  -
  684.       fn  {
  685.         set newname [EntryDialog "Rename" "Please enter new name." $frompwd/[lindex $elem 1] question]
  686.         if {$newname != ""} {
  687.           Log "Renaming $frompwd/[lindex $elem 1] to $newname"
  688.           set r [regexp {ftp://([^/]*)(.*)} $frompwd/[lindex $elem 1] match ftpI oldftpname]
  689.           if {!$r} {
  690.             PopError "Error in URL $frompwd/[lindex $elem 1]"
  691.           } else {
  692.             set r [regexp {ftp://([^/]*)(.*)} $newname match ftpI newftpname]
  693.             if {!$r} {
  694.               PopError "Error in URL $newname"
  695.             } else {
  696.               Try { FTP_Rename $ftpI $oldftpname $newftpname } "" 1
  697.               set glob(forceupdate) 1
  698.             }
  699.           }
  700.         }
  701.       }
  702.       default CantDoThat
  703.     }
  704.   }
  705. }
  706.  
  707.  
  708. proc CmdUnArc {} {
  709.   global glob
  710.   CmdUnArc_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  711.   CmdUnArc_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  712.   UpdateWindow both
  713. }
  714.  
  715. proc CmdUnArc_ { listb_name filelist_var frompwd topwd } {
  716.   upvar $filelist_var filelist
  717.  
  718.   foreach sel [$listb_name curselection] {
  719.     if {[CheckAbort "UnArchive"]} return
  720.     set elem [lindex $filelist $sel]
  721.     switch [lindex $elem 2] {
  722.       ld  -
  723.       d   { PopError "Can't unarchive directory [lindex $elem 1]..." }
  724.       l   -
  725.       n   { Log "Unarchiving $frompwd/[lindex $elem 1] to $topwd"
  726.             UnArcAny $frompwd/[lindex $elem 1] $topwd 
  727.           }
  728.       default CantDoThat
  729.     }
  730.   }
  731. }
  732.  
  733. proc CmdUnPack {} {
  734.   global glob
  735.   CmdUnPack_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  736.   CmdUnPack_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  737.   UpdateWindow both
  738. }
  739.  
  740. proc CmdUnPack_ { listb_name filelist_var frompwd topwd } {
  741.   upvar $filelist_var filelist
  742.  
  743.   foreach sel [$listb_name curselection] {
  744.     if {[CheckAbort "UnPack"]} return
  745.     set elem [lindex $filelist $sel]
  746.     switch [lindex $elem 2] {
  747.       ld  -
  748.       d   { PopError "Can't UnPackhive directory [lindex $elem 1]..." }
  749.       l   -
  750.       n   { Log "Unpacking $frompwd/[lindex $elem 1]"
  751.             UnPackAny $frompwd/[lindex $elem 1] }
  752.       default CantDoThat
  753.     }
  754.   }
  755. }
  756.  
  757.  
  758. proc CmdArc {} {
  759.   global glob
  760.   CmdArc_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  761.   CmdArc_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  762.   UpdateWindow both
  763. }
  764.  
  765. proc CmdArc_ { listb_name filelist_var frompwd topwd } {
  766.   global config glob
  767.   upvar $filelist_var filelist
  768.  
  769.   foreach sel [$listb_name curselection] {
  770.     if {[CheckAbort "Archive"]} return
  771.     set elem [lindex $filelist $sel]
  772.     switch [lindex $elem 2] {
  773.       l   -
  774.       n   { 
  775.         Log "Packing $frompwd/[lindex $elem 1]"
  776. #        Try { eval exec [format $config(cmd,pack) {$frompwd/[lindex $elem 1]}] } "" 1  $glob(async)
  777.         Try { eval eval exec [format $config(cmd,pack) [Esc $frompwd/[lindex $elem 1]]] } "" 1  $glob(async)
  778.       }
  779.       ld  -
  780.       d   { 
  781.         Log "Archiving $frompwd/[lindex $elem 1]"
  782.         if {$config(cmd,archive) == "tar+gz {%s}"} {
  783.           Try { cd $frompwd; exec tar cf - [lindex $elem 1] | gzip > [lindex $elem 1].tar.gz } "" 1 $glob(async)
  784.         } else {
  785.           Try { cd $frompwd; eval eval exec [format $config(cmd,archive) [Esc [lindex $elem 1]] ] } "" 1 $glob(async)
  786.         }
  787.       }
  788.       default CantDoThat
  789.     }
  790.   }
  791. }
  792.  
  793. proc CmdPrint {} {
  794.   global glob
  795.   CmdPrint_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd)
  796.   CmdPrint_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd)
  797. }
  798.  
  799. proc CmdPrint_ { listb_name filelist_var frompwd topwd } {
  800.   global config
  801.   upvar $filelist_var filelist
  802.  
  803.   foreach sel [$listb_name curselection] {
  804.     if {[CheckAbort "Print"]} return
  805.     set elem [lindex $filelist $sel]
  806.     switch [lindex $elem 2] {
  807.       l   -
  808.       n   { Log "Printing $frompwd/[lindex $elem 1]"
  809.             Try { eval eval exec [format $config(cmd,print) [Esc $frompwd/[lindex $elem 1]]] } "" 1 }
  810.       ld  -
  811.       d   { PopError "Can't print directories!!" }
  812.       default CantDoThat
  813.     }
  814.   }
  815. }
  816.  
  817. proc CmdMakeDir {} {
  818.   global config glob
  819.   set focus_win $glob(focus_before_doprotcmd)
  820.   set done false
  821.   if { $focus_win == "$glob(win,left).entry_dir" } {
  822.     set newdir "[$glob(win,left).entry_dir get]"
  823.     set done true
  824.   }
  825.   if { $focus_win == "$glob(win,right).entry_dir" } {
  826.     set newdir "[$glob(win,right).entry_dir get]"
  827.     set done true
  828.   }
  829.   if {$done != "true" } {
  830.     set newdir [EntryDialog "Directory name?" \
  831. "Please enter the name of the new directory. Another way of creating directories is to enter the name the new directory in one\
  832.  of the directory entries and then pressing the MkDir button" "$glob(left,pwd)" question]
  833.     if {$newdir == ""} return
  834.   }
  835.   Log "Creating directory $newdir"
  836.   set r [regexp {ftp://([^/]*)(.*)} $newdir match ftpI dir]
  837.   if {$r} {
  838.     Try { FTP_MkDir $ftpI "$dir" } "" 1
  839.     set glob(forceupdate) 1
  840.   } else {
  841.     Try { file mkdir $newdir } "" 1
  842.   }
  843.   UpdateWindow both
  844.   set glob(forceupdate) 0
  845. }
  846.  
  847. proc CmdSelect {} {
  848.   global glob
  849.   set focus_win $glob(focus_before_doprotcmd)
  850.   set gotit 0
  851.   if { $focus_win == "$glob(win,left).entry_dir" } {
  852.     set pat [$glob(win,left).entry_dir get]
  853.     set inst left
  854.     set gotit 1
  855.   }
  856.   if { $focus_win == "$glob(win,right).entry_dir" } {
  857.     set pat [$glob(win,right).entry_dir get]
  858.     set inst right
  859.     set gotit 1
  860.   }
  861.   if {! $gotit } {
  862.     PopInfo "Please enter a selection pattern in one of the directory entries and then press the Select button"
  863.   } else {
  864.     $glob(win,$inst).entry_dir delete 0 end
  865.     $glob(win,$inst).entry_dir insert end $glob(${inst},pwd)
  866.     set pat [file tail $pat]
  867.     set i 0
  868.     foreach elem $glob($inst,filelist) {
  869.       if {[string match $pat [lindex $elem 1]]} {
  870.         $glob(win,$inst).frame_listb.listbox1 selection set $i
  871.       }
  872.       incr i
  873.     }
  874.   }
  875.   UpdateStat
  876. }
  877.  
  878. proc CmdCSelect {} {
  879.   global glob
  880.   set cmd [EntryDialog "Contents-select" "Make sure you have selected the files you want to search in, then please edit this command to do a contents-select." "grep -i "]
  881.   if { $cmd == "" } return
  882.   CmdCSelect_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd) $cmd
  883.   CmdCSelect_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd) $cmd
  884.   UpdateStat
  885. }
  886.  
  887. proc CmdCSelect_ { listb_name filelist_var frompwd topwd cmd } {
  888.   upvar $filelist_var filelist
  889.  
  890.   foreach sel [$listb_name curselection] {
  891.     set elem [lindex $filelist $sel]
  892.     switch [lindex $elem 2] {
  893.       l   -
  894.       n   { 
  895.             set r [catch { eval exec $cmd {$frompwd/[lindex $elem 1]} } outp]
  896.             if { $r != 0 } {
  897.               $listb_name selection clear $sel
  898.             }
  899.           }
  900.       default CantDoThat
  901.     }
  902.   }
  903. }
  904.  
  905. proc CmdRunCmd {} {
  906.   global glob
  907.   CmdRunCmd_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd) 
  908.   CmdRunCmd_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd) 
  909. }
  910.  
  911. proc CmdRunCmd_ { listb_name filelist_var frompwd topwd } {
  912.   global glob
  913.   upvar $filelist_var filelist
  914.  
  915.   set fl {}
  916.   foreach sel [$listb_name curselection] {
  917.     set elem [lindex $filelist $sel]
  918.     switch [lindex $elem 2] {
  919.       d   -
  920.       ld  -
  921.       l   -
  922.       n   { lappend fl [lindex $elem 1] }
  923.       default CantDoThat
  924.     }
  925.   }
  926.   if { $fl == "" } return
  927.   set cmd [EntryDialog "Run command" "Edit the command line. Ctrl-A takes you to the start of the line." " $fl"]
  928.   if { $cmd == "" } return
  929.   LogSilent "Running command:\n$cmd"
  930.   if {$glob(async)} {
  931.     catch { cd $frompwd; eval exec $cmd & } out
  932.     return
  933.   } else {
  934.     catch { cd $frompwd; eval exec $cmd } out
  935.   }
  936.   if { $out != "" } {
  937.     ViewString "Output from command" out ""
  938.   }
  939.   UpdateWindow both
  940. }
  941.  
  942. proc CmdForEach {} {
  943.   global glob
  944.   CmdForEach_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd) 
  945.   CmdForEach_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd) 
  946. }
  947.  
  948. proc CmdForEach_ { listb_name filelist_var frompwd topwd } {
  949.   global glob config
  950.   upvar $filelist_var filelist
  951.  
  952.   set fl {}
  953.   foreach sel [$listb_name curselection] {
  954.     set elem [lindex $filelist $sel]
  955.     switch [lindex $elem 2] {
  956.       d   -
  957.       ld  -
  958.       l   -
  959.       n   { lappend fl [lindex $elem 1] }
  960.       default CantDoThat
  961.     }
  962.   }
  963.   if { $fl == "" } return
  964.   if {$glob(async)} {
  965.     PopError "This command does not support asynchronous execution"
  966.     return
  967.   }
  968.   if {![info exists glob(foreach,cmd)] || $glob(foreach,cmd) == {}} {
  969.     set glob(foreach,cmd) {echo '%s'}
  970.   }
  971.   set glob(foreach,cmd) [EntryDialog "Foreach" "Enter command to run on each of the selected files. The file will show up in the '%s'. You can use pipes and other bourne-shell syntax elements since the commands will each run in a separate bourne shell." $glob(foreach,cmd)]
  972.   if { $glob(foreach,cmd) == "" } return
  973.  
  974.   set output {}
  975.   foreach k $fl {
  976.     if {[CheckAbort "ForEach"]} return
  977.     set cmd [format "$glob(foreach,cmd)" $k]
  978.     append output "\$ $cmd\n"
  979.     LogStatusOnly "Running $cmd ..."
  980.     catch { cd $frompwd ; exec $config(cmd,sh) -c "$cmd" } out
  981.     append output "$out\n"
  982.   }
  983.   ViewString "Output from commands" output ""
  984.   UpdateWindow both
  985. }
  986.  
  987. proc CmdRecurseCommand { inst } {
  988.   global glob config
  989.  
  990.   set dir $glob($inst,pwd)
  991.  
  992.   if { [IsFTP $dir] } {
  993.     CantDoThat
  994.     return
  995.   }
  996.  
  997.   if {$glob(async)} {
  998.     PopError "This command does not support asynchronous execution"
  999.     return
  1000.   }
  1001.   if {![info exists glob(foreach,cmd)] || $glob(foreach,cmd) == {}} {
  1002.     set glob(foreach,cmd) {echo '%s'}
  1003.   }
  1004.   set e [EntryDialogDouble "Run Command Recursively" "Enter command to run on each file. The file will show up in the '%s'. You can use pipes and other bourne-shell syntax elements since the commands will each run in a separate bourne shell." "Enter pattern to match for when recursing into directories." "This command will run a 'find' of the type\n\n    $ find <directory> -type f -name <pattern> -print\n\nto recurse into the current directory ($dir). The command will then be run on all files from this find.\n\nSee also: manpage for the find command.\n\nUse tab to go to next entry. Return or the OK button starts execution." $glob(foreach,cmd) {*}]
  1005.   if { $e == "" } return
  1006.  
  1007.   set glob(foreach,cmd) [lindex $e 0]
  1008.   set pattern [lindex $e 1]
  1009.   set output {}
  1010.  
  1011.   # expand file list with find outputs
  1012.   set r [catch {cd $dir ; exec $config(cmd,find) . -type f -name $pattern -print} out]
  1013.   if {$r} {
  1014.     PopError "$out"
  1015.     return
  1016.   }
  1017.   set fl [split $out \n]
  1018.   foreach k $fl {
  1019.     if {[CheckAbort "Recurse Command"]} return
  1020.     set cmd [format "$glob(foreach,cmd)" $k]
  1021.     append output "\$ $cmd\n"
  1022.     LogStatusOnly "Running $cmd ..."
  1023.     catch { cd $dir ; exec $config(cmd,sh) -c "$cmd" } out
  1024.     append output "$out\n"
  1025.   }
  1026.   ViewString "Output from commands" output ""
  1027.   UpdateWindow both
  1028. }
  1029.  
  1030.  
  1031. proc CmdDiff {} {
  1032.   global glob
  1033.   CmdDiff_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd) left
  1034.   CmdDiff_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd) right
  1035. }
  1036.  
  1037. proc CmdDiff_ { listb_name filelist_var frompwd topwd inst } {
  1038.   global glob
  1039.   upvar $filelist_var filelist
  1040.   global config
  1041.  
  1042.   set null 1
  1043.   set file1 ""
  1044.   set file2 ""
  1045.  
  1046.   foreach sel [$listb_name curselection] {
  1047.     set null 0
  1048.     set elem [lindex $filelist $sel]
  1049.     switch [lindex $elem 2] {
  1050.       ld  -
  1051.       d   -
  1052.       l   -
  1053.       n   { 
  1054.             if {$file1 == ""} { 
  1055.               set file1 $frompwd/[lindex $elem 1] 
  1056.             } else {
  1057.               if { $file2 != "" } { 
  1058.                 PopError "Please select one or two files or directories for diffing."
  1059.                 return
  1060.               }
  1061.               set file2 $frompwd/[lindex $elem 1] 
  1062.             }
  1063.           }
  1064.       default CantDoThat
  1065.     }
  1066.   }
  1067.  
  1068.   if {$null} return
  1069.  
  1070.   if {$file2 == ""} {
  1071.     set file2 $topwd/[lindex [lindex $glob([Opposite $inst],filelist) [$glob(win,[Opposite $inst]).frame_listb.listbox1 index active]] 1]
  1072.     set tmp $file1
  1073.     set file1 $file2
  1074.     set file2 $tmp
  1075.   }
  1076.  
  1077.   set r [catch { eval eval exec [format $config(cmd,diff) [Esc $file1] [Esc $file2]] } outp]
  1078.   if { $r != 0 } {
  1079.     ViewString "Diffing $file1 and $file2" outp "diff.log"
  1080.   } else {
  1081.     PopInfo "No difference between\n\n$file1\n\nand\n\n$file2"
  1082.   }
  1083. }
  1084.  
  1085. proc CmdCreateEmptyFile { inst } {
  1086.   global glob config
  1087.   set start_entry $glob($inst,pwd)
  1088.   set newfile [EntryDialog "Create New File" "Please enter the name of the new file." $start_entry question]
  1089.  
  1090.   if {$newfile != ""} {
  1091.     Log "Creating new file $newfile"
  1092.     Try { exec $config(cmd,touch) "$newfile" } "" 1
  1093.     UpdateWindow both
  1094.   }
  1095. }
  1096.  
  1097. proc DeleteFTPRecursive { dir inst } {
  1098.   global glob config
  1099.   set r [regexp {ftp://([^/]*)(.*)} $dir match ftpI directory]
  1100.   Log "FTP recursive delete: Entering $dir"
  1101.   NewPwd $inst $dir
  1102.   UpdateWindow $inst
  1103.   foreach elem $glob($inst,filelist) {
  1104.     switch [lindex $elem 2] {
  1105.       fn  -
  1106.       fld -
  1107.       fl  {
  1108.         Log "Deleting $dir/[lindex $elem 1]"
  1109.         FTP_Delete $ftpI "$directory/[lindex $elem 1]"
  1110.       }
  1111.       fd {
  1112.         DeleteFTPRecursive "$dir/[lindex $elem 1]" $inst
  1113.       }
  1114.       default {
  1115.         error "Unexpected file type in FTP recursive delete"
  1116.       }
  1117.     }
  1118.   }
  1119.   Log "Deleting $dir"
  1120.   NewPwd $inst "$dir/.."
  1121.   FTP_RmDir $ftpI "$directory"
  1122. }
  1123.  
  1124. proc CopyFromFTPRecursive { fromdir todir inst resume } {
  1125.   global glob config
  1126.   if {[CheckAbort "CopyFromFTPRecursive"]} return
  1127.   set r [regexp {ftp://([^/]*)(.*)} $fromdir match ftpI directory]
  1128.   set dir [file tail $directory]
  1129.   Log "FTP recursive copy: Creating $todir/$dir"
  1130.   file mkdir "$todir/$dir"
  1131.   Log "FTP recursive copy: Entering $fromdir"
  1132.   NewPwd $inst $fromdir
  1133.   UpdateWindow $inst
  1134.   foreach elem $glob($inst,filelist) {
  1135.     if {[CheckAbort "CopyFromFTPRecursive"]} return
  1136.     switch [lindex $elem 2] {
  1137.       fld -
  1138.       fl {
  1139.         Log "Skipping $fromdir/[lindex $elem 1] - link"
  1140.       }
  1141.       fd {
  1142.         CopyFromFTPRecursive "$fromdir/[lindex $elem 1]" "$todir/$dir" $inst $resume
  1143.       }
  1144.       fn {
  1145.         Log "FTP recursive copy: Copying $fromdir/[lindex $elem 1] -> $todir/$dir/[lindex $elem 1] ([lindex $elem 3] bytes)"
  1146.         FTP_GetFile $ftpI "$directory/[lindex $elem 1]" "$todir/$dir/[lindex $elem 1]" "[lindex $elem 3]" $resume
  1147.       }
  1148.       default {
  1149.         error "Unexpected file type in FTP recursive copy"
  1150.       }
  1151.     }
  1152.   }
  1153. }
  1154.  
  1155. proc CopyToFTPRecursive { fromdir todir inst } {
  1156.   global glob config
  1157.   if {[CheckAbort "CopyToFTPRecursive"]} return
  1158.   set r [regexp {ftp://([^/]*)(.*)} $todir match ftpI directory]
  1159.   set dir [file tail $fromdir]
  1160.   Log "FTP recursive copy: Creating $todir/$dir"
  1161.   FTP_MkDir $ftpI "$directory/$dir"
  1162.   Log "FTP recursive copy: Entering $fromdir"
  1163.   NewPwd $inst $fromdir
  1164.   UpdateWindow $inst
  1165.   foreach elem $glob($inst,filelist) {
  1166.     if {[CheckAbort "CopyToFTPRecursive"]} return
  1167.     switch [lindex $elem 2] {
  1168.       ld -
  1169.       l {
  1170.         Log "Skipping $fromdir/[lindex $elem 1] - link"
  1171.       }
  1172.       d {
  1173.         CopyToFTPRecursive "$fromdir/[lindex $elem 1]" "$todir/$dir" $inst
  1174.       }
  1175.       n {
  1176.         Log "FTP recursive copy: Copying $fromdir/[lindex $elem 1] -> $todir/$dir/[lindex $elem 1] ([lindex $elem 3] bytes)"
  1177.         FTP_PutFile $ftpI "$fromdir/[lindex $elem 1]" "$directory/$dir/[lindex $elem 1]" "[lindex $elem 3]"
  1178.       }
  1179.       default {
  1180.         error "Unexpected file type in FTP recursive copy"
  1181.       }
  1182.     }
  1183.   }
  1184. }
  1185.  
  1186. proc CmdFind { inst } {
  1187.   global glob config
  1188.   set findname [EntryDialog "Find..." "Please enter substring of filename to search for in $glob($inst,pwd) and below." \
  1189.       "" "question"]
  1190.   if {$findname == ""} return
  1191.   if {[IsFTP $glob($inst,pwd)]} {
  1192.     regexp {ftp://([^/]*)(.*)} $glob($inst,pwd) match ftpI directory
  1193.     set r [catch {FTP_CD $ftpI $directory} out]
  1194.     if {$r != 0} {
  1195.       PopError $out
  1196.       return
  1197.     }
  1198.     LogStatusOnly "Searching, please wait..."
  1199.     set r [catch {FTP_DoSearch $ftpI $findname} out]
  1200.     LogStatusOnly "Searching, please wait...done"
  1201.     if {$r} {
  1202.       PopError "FTP search error: $out"
  1203.       return
  1204.     }
  1205.     ViewString "FTP search results" out ""
  1206.     return
  1207.   }
  1208.   set r [catch {cd $glob($inst,pwd)} out]
  1209.   if {$r} {
  1210.     PopError "$out"
  1211.     return
  1212.   }
  1213.   LogStatusOnly "Searching, please wait..."
  1214.   set r [catch {exec $config(cmd,sh) -c "find . -name '*${findname}*' -print" 2> /dev/null } out]
  1215.   LogStatusOnly "Searching, please wait...done"
  1216. #  if {$r} {
  1217. #    PopError "Search error: $out"
  1218. #    return
  1219. #  }
  1220.   set out [split $out "\n"]
  1221.   if {[string range [lindex $out end] 0 4] == "child"} {
  1222.     set out [lrange $out 0 [expr [llength $out] - 2]]
  1223.   }
  1224.   if {[string trim $out] == ""} {
  1225.     PopInfo "No file found"
  1226.     return
  1227.   }
  1228.   FindDialog $out $inst
  1229. }
  1230.  
  1231.  
  1232. proc CmdChmod {} {
  1233.   global glob
  1234.   CmdChmod_ $glob(win,left).frame_listb.listbox1 glob(left,filelist) $glob(left,pwd) $glob(right,pwd) left
  1235.   CmdChmod_ $glob(win,right).frame_listb.listbox1 glob(right,filelist) $glob(right,pwd) $glob(left,pwd) right
  1236.   UpdateWindow both
  1237. }
  1238.  
  1239. proc CmdChmod_ { listb_name filelist_var frompwd topwd inst } {
  1240.   # For speed, (hopefully) we'll call by reference...
  1241.   global config glob
  1242.   upvar $filelist_var filelist
  1243.   set fl {}
  1244.  
  1245.   foreach sel [$listb_name curselection] {
  1246.     if {[CheckAbort "Chmod"]} return
  1247.     set elem [lindex $filelist $sel]
  1248.     switch [lindex $elem 2] {
  1249.       l   -
  1250.       ld  -
  1251.       n   -
  1252.       d   {
  1253.         if {$fl == {}} {
  1254.           set mode [lindex $elem 5]
  1255.         }
  1256.         lappend fl [Esc $frompwd/[lindex $elem 1]]
  1257.       }
  1258.       default CantDoThat
  1259.     }
  1260.   }
  1261.   if {$fl != ""} {
  1262.     set arg [ChmodDialog "$frompwd/[lindex $elem 1]" $mode]
  1263.     if {$arg != ""} {
  1264.       Try { eval eval exec $config(cmd,chmod) $arg $fl } "" 1 $glob(async)
  1265.     }
  1266.   }
  1267. }
  1268.  
  1269. proc CmdGetHttp { inst } {
  1270.   global glob config
  1271.   
  1272.   if {[IsFTP $glob($inst,pwd)]} {
  1273.     PopInfo "You can only download HTTP files to a non-FTP directory"
  1274.     return
  1275.   }
  1276.  
  1277.   if {![info exists glob(http,lasturl)]} {
  1278.     set glob(http,lasturl) {}
  1279.   }
  1280.   set URL $glob(http,lasturl)
  1281.  
  1282.   while { 1 } {
  1283.     set URL [EntryDialog "Get HTTP File" "Please enter HTTP URL to download" $URL]
  1284.     if {$URL == ""} {
  1285.       return
  1286.     }
  1287.     
  1288.     if {[string range $URL 0 6] != "http://" } {
  1289.       set URL "http://$URL"
  1290.     }
  1291.     
  1292.     set r [regexp {http://([^/]*)(.*)} $URL match host_and_port location]
  1293.     if {!$r} {
  1294.       PopError "Could not parse $URL as an HTTP URL"
  1295.       continue
  1296.     } 
  1297.     if {$location == ""} {
  1298.       append URL /
  1299.     }
  1300.     set glob(http,lasturl) $URL
  1301.     break
  1302.   }
  1303.  
  1304.   set filename [file tail $URL]
  1305.   if {[string range $URL end end] == "/"} {
  1306.     append filename .html
  1307.   }
  1308.   set filename [EntryDialog "Get HTTP File" "Please edit filename to save to.\n(URL: $URL)" $filename]
  1309.   if {$filename == ""} {
  1310.     return
  1311.   }
  1312.   cd $glob($inst,pwd)
  1313.   HTTP_Get $URL $filename
  1314.   UpdateWindow both
  1315. }
  1316.  
  1317.